home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
sp12src.zip
/
PAIRHEAP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-04-20
|
6KB
|
215 lines
(****************************************************************)
(* Copyright (c) 1989 by Edwin T. Floyd *)
(* *)
(* Generalized Pairing Heap unit (partial implementation) *)
(* *)
(* By: Edwin T. Floyd [76067,747] *)
(* #9 Adams Park Court *)
(* Columbus, GA 31909 *)
(* (404) 322-0076 (home) *)
(* (404) 576-3305 (work) *)
(* *)
(****************************************************************)
{$A+,B-,D+,E-,F+,I-,L+,N-,O-,R-,S-,V+}
Unit PairHeap;
Interface
Type
HeapEntryPtr = ^HeapEntry;
HeapEntry = Object { Header on each heap record }
Offspring : HeapEntryPtr; { Ordered half-tree }
Sibling : HeapEntryPtr; { Unordered half-tree }
End;
Heap = Object { Generalized pairing heap }
HeapTop : HeapEntryPtr; { Current top of heap }
HeapCount : LongInt; { Number of records in heap }
{ Methods }
Constructor Init; { Initialize Heap }
Destructor Done; Virtual;{ Dummy virtural destructor }
Function Less(Var x, y : HeapEntry) : Boolean; Virtual;
{ Override with your own compare function; returns TRUE if x < y }
Function Empty : Boolean;
{ Returns TRUE if heap is empty }
Function EntryCount : LongInt;
{ Returns number of records on heap }
Procedure Insert(Var Entry : HeapEntry);
{ Insert record in heap }
Function LowEntry : Pointer;
{ Return pointer to smallest record on heap, or NIL if heap is empty }
Function DeleteLowEntry : Pointer;
{ Like LowEntry, but also deletes smallest record from heap }
End;
TopSoMany = Object(Heap)
{ This heap keeps only the top N (specified in Init) entries. }
MinEntry : HeapEntryPtr; { Pointer to current lowest entry on heap }
DiscardPile : HeapEntryPtr; { Chain of discarded entries }
MaxEntryCount : LongInt; { Maximum number of entries permitted on heap }
DiscardCount : LongInt; { Number of entries on the discard pile }
Constructor Init(Max : LongInt);
{ Initialize control block, specify the maximum number of entries to keep }
Procedure Insert(Var Entry : HeapEntry);
{ Insert an entry }
Function GetDiscard : Pointer;
{ Remove an entry from the discard pile; returns a pointer to the entry
or Nil if discard pile is empty. }
End;
Implementation
Constructor Heap.Init;
{ Initialize heap control area }
Begin
HeapTop := Nil;
HeapCount := 0;
End;
Destructor Heap.Done; Begin End;
{ Dummy destructor }
Function Heap.Less(Var x, y : HeapEntry) : Boolean;
Begin
WriteLn('PAIRHEAP: You must override Heap.Less');
Halt(1);
End;
Function Heap.Empty : Boolean;
{ Returns true if heap is empty }
Begin
Empty := HeapTop = Nil;
End;
Function Heap.EntryCount : LongInt;
{ Returns the number of elements in the heap }
Begin
EntryCount := HeapCount;
End;
Procedure Heap.Insert(Var Entry : HeapEntry);
{ Insert record in heap }
Begin
With Entry Do Begin
Sibling := HeapTop;
Offspring := Nil;
HeapTop := @Entry;
Inc(HeapCount);
End;
End;
Procedure SortHeapTop(Var Control : Heap);
{ Locate the smallest record in the heap and point HeapTop to it }
Var
x, z : HeapEntryPtr;
Procedure SortPair; { x given }
{ y := Sibling(x); z := sibling(y); x := Lowest(x, y); Offspring(x) := y }
Var
y : HeapEntryPtr;
Begin { SortPair}
With x^ Do Begin
y := Sibling;
Sibling := Nil;
End;
If y = Nil Then z := Nil Else Begin
With y^ Do Begin
z := Sibling;
Sibling := Nil;
End;
If Control.Less(x^, y^) Then Begin
y^.Sibling := x^.Offspring;
x^.Offspring := y;
End Else Begin
x^.Sibling := y^.Offspring;
y^.Offspring := x;
x := y;
End;
End;
End; { SortPair }
Begin { SortHeapTop }
With Control Do Begin
If HeapTop <> Nil Then Repeat
x := HeapTop;
SortPair;
HeapTop := x;
With HeapTop^ Do While z <> Nil Do Begin
x := z;
SortPair;
x^.Sibling := Sibling;
Sibling := x;
End;
Until HeapTop^.Sibling = Nil;
End;
End; { SortHeapTop }
Function Heap.LowEntry : Pointer;
{ Return pointer to smallest heap record }
Begin
SortHeapTop(Self);
LowEntry := HeapTop;
End;
Function Heap.DeleteLowEntry : Pointer;
{ Remove smallest heap record and return a pointer to it }
Begin
DeleteLowEntry := LowEntry;
If HeapTop <> Nil Then Begin
HeapTop := HeapTop^.Offspring;
Dec(HeapCount);
End;
End;
Constructor TopSoMany.Init(Max : LongInt);
Begin
If Max < 1 Then Begin
WriteLn('TopSoMany.Init Max must be > 0');
Halt(1);
End;
Heap.Init;
MinEntry := Nil;
DiscardPile := Nil;
MaxEntryCount := Max;
DiscardCount := 0;
End;
Procedure TopSoMany.Insert(Var Entry : HeapEntry);
Begin
If HeapCount < MaxEntryCount Then Begin
If (MinEntry = Nil) Or Less(Entry, MinEntry^) Then MinEntry := @Entry;
Heap.Insert(Entry);
End Else Begin
If Less(MinEntry^, Entry) Then Begin
MinEntry := DeleteLowEntry;
MinEntry^.Sibling := DiscardPile;
DiscardPile := MinEntry;
Heap.Insert(Entry);
MinEntry := LowEntry;
End Else Begin
Entry.Sibling := DiscardPile;
DiscardPile := @Entry;
End;
Inc(DiscardCount);
End;
End;
Function TopSoMany.GetDiscard : Pointer;
Begin
GetDiscard := DiscardPile;
If DiscardPile <> Nil Then Begin
DiscardPile := DiscardPile^.Sibling;
Dec(DiscardCount);
End;
End;
End.